home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / sml_nj / 93src.lha / src / cps / cpscomp.sml < prev    next >
Encoding:
Text File  |  1993-01-27  |  3.5 KB  |  123 lines
  1. (* Copyright 1989 by AT&T Bell Laboratories *)
  2. functor CPScomp(CM : CMACHINE) : 
  3.     sig val compile : CPS.function * System.Unsafe.object option * ErrorMsg.complainer -> unit 
  4.     end =
  5. struct
  6.  
  7. val maxfree = case CM.arithtemps of [] => 3+length(CM.miscregs)-1
  8.                                   | _ => 3+length(CM.miscregs)
  9.  
  10. structure CPSg = CPSgen(CM)
  11. structure CPSopt = CPSopt(val maxfree = maxfree)
  12. structure Eta = CPSopt.Eta;
  13. structure Closure = Closure(val maxfree = maxfree)
  14. (*
  15. structure ClosureCallee = ClosureCallee(val maxfree = maxfree)
  16. *)
  17. structure Spill = Spill(val maxfree = maxfree)
  18. val pr = System.Print.say
  19.  
  20. fun time (f,m,s,p) x =
  21.   let val _ = CompUtil.debugmsg m
  22.       val t = System.Timer.start_timer()
  23.       val r = f x
  24.       val t' = System.Timer.check_timer t
  25.   in  System.Stats.update(s,t');
  26.       if (!System.Control.CG.printit orelse !System.Control.CG.printsize)
  27.       then (pr "\nAfter "; pr m; pr ":\n")
  28.       else ();
  29.       CompUtil.timemsg m t';
  30.       p r;
  31.       System.Print.flush();
  32.       r
  33.   end
  34.  
  35. fun fprint (function as (f,vl,cps)) =
  36.   (if !System.Control.CG.printsize
  37.        then CPSsize.printsize cps
  38.    else ();
  39.    if !System.Control.CG.printit
  40.        then CPSprint.showfun pr function
  41.    else ())
  42.        
  43. fun flprint functions = 
  44.   if !System.Control.CG.printit
  45.       then app (CPSprint.showfun pr) functions
  46.   else ()
  47.  
  48. fun nullprint _ = ()
  49.  
  50. fun compile(function,argument,err) =
  51.  let
  52.  
  53.   val _ = if !System.Control.CG.printit orelse !System.Control.CG.printsize
  54.          then (pr "\nAfter convert:\n";
  55.            fprint function; System.Print.flush())
  56.  
  57.              else ()
  58.  
  59.   val reduce = CPSopt.reduce
  60.  
  61.   val cpsopt = if !System.Control.CG.cpsopt
  62.         then time(reduce,"cpsopt",System.Stats.cpsopt,fprint)
  63.         else fn (cps,_,_) => cps
  64.   val function = cpsopt(function,argument,false)
  65.  
  66.   val fiddle = if !System.Control.CG.knownfiddle
  67.                 then time(KnownFiddle.fiddle,"knownfiddle",
  68.               System.Stats.closure, fprint)
  69.         else fn cps => cps
  70.  
  71.   val function = fiddle function
  72.  
  73.   val closure = time(Closure.closeCPS,"closure",
  74.              System.Stats.closure,fprint)
  75.   val function = closure function
  76.  
  77.   val unfiddle = if !System.Control.CG.knownfiddle
  78.                 then time(fn f => Eta.eta{function=f,afterClosure=true},
  79.               "unfiddle", System.Stats.closure, fprint)
  80.         else fn cps => cps
  81.       
  82.   val function = unfiddle function
  83.  
  84.  
  85.   val globalfix = time(GlobalFix.globalfix,"globalfix",
  86.                System.Stats.globalfix,flprint)
  87.   val carg = globalfix function
  88.  
  89.   fun reoptimize((f,vl,body)::carg') = 
  90.            globalfix(cpsopt((f,vl,CPS.FIX(carg',body)),argument,true))
  91.     | reoptimize _ = ErrorMsg.impossible "reoptimize"
  92.  
  93.   val carg = if !System.Control.CG.optafterclosure
  94.     then let open System.Control.CG
  95.          val u = !hoistup and d = !hoistdown
  96.      in hoistup := false; hoistdown := false;
  97.             reoptimize carg            
  98.             before (hoistup := u; hoistdown := d)
  99.          end
  100.     else carg
  101.  
  102.   val spill     = time(Spill.spill,"spill",System.Stats.spill,flprint)
  103.   val carg = spill carg
  104.  
  105. (**
  106.   val branch = time(Branch.branch, "branch", System.Stats.spill)
  107.   val carg = if !System.Control.CG.misc3>0 then branch carg else carg
  108.   val _ = (flprint carg; write "\n")
  109. **)
  110.  
  111.   val limit = time(Limit.nolimit,"limit",System.Stats.globalfix,nullprint)
  112.   val limits = limit carg
  113.  
  114.   val codegen   = time(CPSg.codegen,"generic",System.Stats.codegen,nullprint)
  115.   val _ = codegen(carg,limits,err)
  116.   val _ = CompUtil.debugmsg "\ndone\n"
  117.  in  ()
  118.  end
  119. (* end of compile *)
  120.  
  121.  
  122. end (* functor CPScomp *)
  123.